home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 11
/
CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso
/
cucd
/
programming
/
oberonv4
/
source
/
system
/
amigaexec.mod
(
.txt
)
< prev
next >
Wrap
Oberon Text
|
1996-07-28
|
15KB
|
474 lines
Syntax10.Scn.Fnt
Syntax10i.Scn.Fnt
ParcElems
Alloc
Syntax10b.Scn.Fnt
Syntax16b.Scn.Fnt
Syntax16.Scn.Fnt
MODULE AmigaExec; (* SHML/CN 15. Mar 93, 23 Jun 94, RD 25 Dec 95, OJ 30 Apr 96 *)
Register() and TermAll() added for correct cleanup, OJ 11-May-96
Interface of WaitIO(), SendIO() changed, OJ 26-May-96
IMPORT SYSTEM;
CONST
true * = LONG(1); (* use these !! *)
false * = LONG(0);
null * = LONG(LONG(0));
(* Flags for AllocMem *)
memAny * = {}; (* Any type of memory will do *)
memPublic * = 0;
memChip * = 1;
memFast * = 2;
memLocal * = 8;
mem24BitDMA * = 9; (* DMAable memory within 24 bits of address *)
memKick * = 10; (* Memory that can be used for KickTags *)
memClear * = 16;
memLargest * = 17;
memReverse * = 18;
memTotal * = 19; (* AvailMem: return total size of memory *)
memNoExpunge * = 31; (* AllocMem: Do not cause expunge on failure *)
(* IORequest.command: *)
invalid * = 0;
reset * = 1;
read * = 2;
write * = 3;
update * = 4;
clear * = 5;
stop * = 6;
start * = 7;
flush * = 8;
nonstd * = 9;
(* node types for lists *)
ntUnknown * = 0;
ntTask * = 1; (* Exec task *)
ntInterrupt * = 2;
ntDevice * = 3;
ntMsgPort * = 4;
ntMessage * = 5; (* Indicates message currently pending *)
ntFreeMsg * = 6;
ntReplyMsg * = 7; (* Message has been replied *)
ntResource * = 8;
ntLibrary * = 9;
ntMemory * = 10;
ntSoftInt * = 11; (* Internal flag used by SoftInits *)
ntFont * = 12;
ntProcess * = 13; (* AmigaDOS Process *)
ntSemaphore * = 14;
ntSignalSem * = 15; (* signal semaphores *)
ntBootNode * = 16;
ntKickMem * = 17;
ntGraphics * = 18;
ntDeathMessage * = 19;
ntUser * = -2; (* User node types work down from here *)
ntExtended * = -1;
PROC*=PROCEDURE;
TaskPtr*=LONGINT;
UnitPtr* = LONGINT;
IORequestPtr * = LONGINT;
IOStdReqPtr * = LONGINT;
NodePtr*=LONGINT;
Node*=RECORD
succ*:NodePtr;
pred*:NodePtr;
type*:SHORTINT;
pri*:SHORTINT;
name*:LONGINT
END;
List*=RECORD
head*:NodePtr;
tail*:NodePtr;
tailPred*:NodePtr;
type*:SHORTINT;
pad*:SHORTINT
END;
MinNodePtr*=LONGINT;
MinNode*=RECORD
succ*:MinNodePtr;
pred*:MinNodePtr
END;
MinList*=RECORD
head*,tail*,tailPred*:MinNodePtr
END;
MsgPortPtr*=LONGINT;
MsgPort*=RECORD
node*:Node;
flags*:SHORTINT;
sigBit*:SHORTINT;
sigTask*:TaskPtr;
msgList*:List
END;
Unit * = RECORD
msgPort * : MsgPort; (* queue for unprocessed messages *)
(* instance of msgport is recommended *)
flags * : SHORTINT;
pad * : SHORTINT;
openCnt * : INTEGER; (* number of active opens *)
END;
SemaphoreRequest*=RECORD
link*:MinNode;
waiter*:TaskPtr
END;
SignalSemaphore*=RECORD
link*:Node;
nestCount*:INTEGER;
waitQueue*:MinList;
multipleLink*:SemaphoreRequest;
owner*:TaskPtr;
queueCount*:INTEGER
END;
Message*=RECORD
node*:Node;
replyPort*:MsgPortPtr;
length*:INTEGER
END;
MessagePtr*=LONGINT;
Task*=RECORD
node*:Node;
flags*:SHORTINT;
state*:SHORTINT;
idNestCnt:SHORTINT;
tdNestCnt:SHORTINT;
sigAlloc:SET;
sigWait*:SET;
sigRecvd*:SET;
sigExcept:SET;
trapAlloc:INTEGER;
trapAble:INTEGER;
exceptData*:LONGINT;
exceptCode*:LONGINT;
trapData*:LONGINT;
trapCode*:LONGINT;
spReg*:LONGINT;
spLower*:LONGINT;
spUpper*:LONGINT;
switch:LONGINT;
launch:LONGINT;
memEntry:List;
userData*:LONGINT
END;
Library*=RECORD
node*:Node;
flags*:SHORTINT;
pad*:SHORTINT;
negSize*:INTEGER;
posSize*:INTEGER;
version*:INTEGER;
revision*:INTEGER;
idString*:LONGINT;
sum*:LONGINT;
openCnt*:INTEGER
END;
LibraryPtr*=LONGINT;
DevicePtr*=LONGINT;
IORequest * = RECORD
message * : Message;
device * : DevicePtr; (* device node pointer *)
unit * : UnitPtr; (* unit (driver private)*)
command * : INTEGER; (* device command *)
flags * : SHORTINT;
error * : SHORTINT; (* error or warning num *)
END;
IOStdReq * = RECORD
message * : Message;
device * : DevicePtr; (* device node pointer *)
unit * : UnitPtr; (* unit (driver private)*)
command * : INTEGER; (* device command *)
flags * : SHORTINT;
error * : SHORTINT; (* error or warning num *)
actual * : LONGINT; (* actual number of bytes transferred *)
length * : LONGINT; (* requested number bytes transferred*)
data * : LONGINT; (* points to data area *)
offset * : LONGINT; (* offset for block structured devices *)
END;
MemPoolPtr*=LONGINT;
TermProc = PROCEDURE ();
TermEntryPtr = LONGINT;
TermEntry * = RECORD
next : TermEntryPtr;
proc : TermProc;
END;
execBase- : LibraryPtr;
execVersion- : INTEGER;
termEntry : TermEntry;
termList : TermEntryPtr;
dummy : LONGINT;
PROCEDURE -ReturnD0 04EH,05EH, 04EH,075H;
PROCEDURE AddTask*(task:TaskPtr; initialPC, finalPC:LONGINT):LONGINT;
BEGIN
SYSTEM.PUTREG( 9, task );
SYSTEM.PUTREG( 10, initialPC );
SYSTEM.PUTREG( 11, finalPC );
SYSTEM.CALL( -282, execBase );
ReturnD0
END AddTask;
PROCEDURE RemTask*(task:TaskPtr);
BEGIN
SYSTEM.PUTREG( 9, task );
SYSTEM.CALL( -288, execBase );
ReturnD0
END RemTask;
PROCEDURE AllocMem*(size:LONGINT; reqs:SET):LONGINT;
BEGIN
SYSTEM.PUTREG( 0, size );
SYSTEM.PUTREG( 1, reqs );
SYSTEM.CALL( -198, execBase );
ReturnD0
END AllocMem;
PROCEDURE FreeMem*(adr,size:LONGINT);
BEGIN
SYSTEM.PUTREG( 9, adr );
SYSTEM.PUTREG( 0, size );
SYSTEM.CALL( -210, execBase )
END FreeMem;
PROCEDURE CopyMemAPTR*(source,dest,size:LONGINT);
BEGIN
SYSTEM.PUTREG( 8, source );
SYSTEM.PUTREG( 9, dest );
SYSTEM.PUTREG( 0, size );
SYSTEM.CALL( -624, execBase )
END CopyMemAPTR;
PROCEDURE Forbid*();
BEGIN
SYSTEM.CALL( -132, execBase )
END Forbid;
PROCEDURE FindTask*(name:LONGINT):TaskPtr;
BEGIN
SYSTEM.PUTREG( 9, name );
SYSTEM.CALL( -294, execBase );
ReturnD0
END FindTask;
PROCEDURE Permit*();
BEGIN
SYSTEM.CALL( -138, execBase )
END Permit;
PROCEDURE SetTaskPri*(task: TaskPtr; pri: LONGINT): LONGINT;
BEGIN
SYSTEM.PUTREG( 9, task );
SYSTEM.PUTREG( 0, pri );
SYSTEM.CALL( -300, execBase );
ReturnD0
END SetTaskPri;
PROCEDURE SetExcept*(newSig, setSig : SET) : SET;
BEGIN
SYSTEM.PUTREG( 0, newSig);
SYSTEM.PUTREG( 1, setSig);
SYSTEM.CALL( -312, execBase);
ReturnD0
END SetExcept;
PROCEDURE Signal*( task : TaskPtr; sig : SET);
BEGIN
SYSTEM.PUTREG( 9, task);
SYSTEM.PUTREG( 0, sig);
SYSTEM.CALL( -324, execBase);
END Signal;
PROCEDURE OpenLibrary*(libName:ARRAY OF CHAR; version:LONGINT):LibraryPtr;
BEGIN
SYSTEM.PUTREG( 9, SYSTEM.ADR(libName) );
SYSTEM.PUTREG( 0, version );
SYSTEM.CALL( -552, execBase );
ReturnD0
END OpenLibrary;
PROCEDURE CloseLibrary*(libBase:LibraryPtr);
BEGIN
SYSTEM.PUTREG( 9, libBase );
SYSTEM.CALL( -414, execBase );
END CloseLibrary;
PROCEDURE OpenDevice*(devName:ARRAY OF CHAR; unit: LONGINT;
ioRequest: IORequestPtr; flags: SET) : SHORTINT;
BEGIN
SYSTEM.PUTREG( 8, SYSTEM.ADR(devName) );
SYSTEM.PUTREG( 0, unit );
SYSTEM.PUTREG( 9, ioRequest );
SYSTEM.PUTREG( 1, flags );
SYSTEM.CALL( -444, execBase );
SYSTEM.GETREG( 0, dummy );
RETURN SHORT(SHORT(dummy))
END OpenDevice;
PROCEDURE CloseDevice*(ioRequest: IORequestPtr);
BEGIN
SYSTEM.PUTREG( 9, ioRequest );
SYSTEM.CALL( -450, execBase )
END CloseDevice;
PROCEDURE WaitPort*(port: MsgPortPtr);
BEGIN
SYSTEM.PUTREG( 8, port );
SYSTEM.CALL( -384, execBase )
END WaitPort;
PROCEDURE GetMsg*(port: MsgPortPtr): MessagePtr;
BEGIN
SYSTEM.PUTREG( 8, port );
SYSTEM.CALL( -372, execBase );
ReturnD0
END GetMsg;
PROCEDURE ReplyMsg*(msg: MessagePtr);
BEGIN
SYSTEM.PUTREG( 9, msg );
SYSTEM.CALL( -378, execBase )
END ReplyMsg;
PROCEDURE DoIO*(ioRequest: IORequestPtr): SHORTINT;
BEGIN
SYSTEM.PUTREG( 9, ioRequest );
SYSTEM.CALL( -456, execBase );
SYSTEM.GETREG( 0, dummy );
RETURN SHORT(SHORT(dummy))
END DoIO;
PROCEDURE SendIO*(ioRequest: IORequestPtr);
BEGIN
SYSTEM.PUTREG( 9, ioRequest );
SYSTEM.CALL( -462, execBase )
END SendIO;
PROCEDURE CheckIO*(ioRequest: IORequestPtr): BOOLEAN;
BEGIN
SYSTEM.PUTREG( 9, ioRequest );
SYSTEM.CALL( -468, execBase );
SYSTEM.GETREG( 0, dummy );
RETURN dummy#false
END CheckIO;
PROCEDURE WaitIO*(ioRequest: IORequestPtr): SHORTINT;
BEGIN
SYSTEM.PUTREG( 9, ioRequest );
SYSTEM.CALL( -474, execBase );
SYSTEM.GETREG( 0, dummy );
RETURN SHORT(SHORT(dummy))
END WaitIO;
PROCEDURE AbortIO*(ioRequest: IORequestPtr): LONGINT;
BEGIN
SYSTEM.PUTREG( 9, ioRequest );
SYSTEM.CALL( -480, execBase );
ReturnD0
END AbortIO;
PROCEDURE CreateMsgPort*(): MsgPortPtr;
BEGIN
SYSTEM.CALL( -666, execBase );
ReturnD0
END CreateMsgPort;
PROCEDURE DeleteMsgPort*(port: MsgPortPtr);
BEGIN
SYSTEM.PUTREG( 8, port );
SYSTEM.CALL( -672, execBase )
END DeleteMsgPort;
PROCEDURE CreateIORequest*(port: MsgPortPtr; size: LONGINT): IORequestPtr;
BEGIN
SYSTEM.PUTREG( 8, port );
SYSTEM.PUTREG( 0, size );
SYSTEM.CALL( -654, execBase );
ReturnD0
END CreateIORequest;
PROCEDURE DeleteIORequest*(iorequest: IORequestPtr);
BEGIN
SYSTEM.PUTREG( 8, iorequest );
SYSTEM.CALL( -660, execBase )
END DeleteIORequest;
(* Memory Pool Procedures *)
PROCEDURE CreatePool*(reqs: SET; puddleSize, threshSize: LONGINT):MemPoolPtr;
BEGIN
SYSTEM.PUTREG( 0, reqs );
SYSTEM.PUTREG( 1, puddleSize );
SYSTEM.PUTREG( 2, threshSize );
SYSTEM.CALL( -696, execBase );
ReturnD0
END CreatePool;
PROCEDURE DeletePool*(pool: MemPoolPtr);
BEGIN
SYSTEM.PUTREG( 8, pool );
SYSTEM.CALL( -702, execBase )
END DeletePool;
PROCEDURE AllocPooled*(pool: MemPoolPtr; size: LONGINT):LONGINT;
BEGIN
SYSTEM.PUTREG( 8, pool );
SYSTEM.PUTREG( 0, size );
SYSTEM.CALL( -708, execBase );
ReturnD0
END AllocPooled;
PROCEDURE FreePooled*(pool: MemPoolPtr; adr, size: LONGINT);
BEGIN
SYSTEM.PUTREG( 8, pool );
SYSTEM.PUTREG( 9, adr );
SYSTEM.PUTREG( 0, size );
SYSTEM.CALL( -714, execBase )
END FreePooled;
(* Exec support *)
PROCEDURE CreateTask*(name:ARRAY OF CHAR; pri:SHORTINT; initPC:PROC; stackSize:LONGINT):TaskPtr;
TaskPointer = POINTER TO Task;
NamePtr = POINTER TO ARRAY 1 OF CHAR;
newptr, task: TaskPtr; newtask: TaskPointer;
stack: LONGINT;
p : NamePtr;
BEGIN
task := null;
newptr := AllocMem(SIZE(Task), {memClear});
IF newptr # null THEN
stackSize := (stackSize + 7) DIV 8 * 8;
stack := AllocMem(stackSize, {memPublic});
IF stack # null THEN
p := SYSTEM.VAL( NamePtr, AllocMem(LEN(name)+1, {}) );
IF p # NIL THEN COPY(name, p^);
newtask := SYSTEM.VAL(TaskPointer, newptr);
newtask.spLower := stack;
newtask.spUpper := stack+stackSize;
newtask.spReg := newtask.spUpper;
newtask.node.type := ntTask;
newtask.node.pri := pri;
newtask.node.name := SYSTEM.VAL(LONGINT,p);
task := AddTask(newptr, SYSTEM.VAL(LONGINT,initPC), null);
END;
END;
END;
IF task = null THEN
IF newptr # null THEN
IF stack # null THEN
IF p # NIL THEN FreeMem(SYSTEM.VAL(LONGINT,p), LEN(name)+1) END;
FreeMem(stack, stackSize)
END;
FreeMem(newptr, SIZE(Task))
END;
END;
RETURN task
END CreateTask;
PROCEDURE DeleteTask*(ptr:TaskPtr);
TaskPointer = POINTER TO Task;
NamePtr = POINTER TO ARRAY 1 OF CHAR;
task: TaskPointer;
p : NamePtr;
BEGIN
IF ptr # null THEN
RemTask(ptr);
task := SYSTEM.VAL(TaskPointer, ptr); p := SYSTEM.VAL(NamePtr,task.node.name);
FreeMem(task.node.name, LEN(p^)+1);
FreeMem(task.spLower, task.spUpper-task.spLower);
FreeMem(ptr, SIZE(Task));
END;
END DeleteTask;
PROCEDURE TermAll*;
(* called by Amiga.Close *)
TYPE TermEntryPointer = POINTER TO TermEntry;
VAR tl : TermEntryPointer;
BEGIN
WHILE termList # 0 DO
tl := SYSTEM.VAL( TermEntryPointer, termList );
tl.proc();
termList := tl.next
END;
END TermAll;
PROCEDURE Register*(VAR entry : TermEntry; proc : TermProc);
BEGIN
entry.proc := proc; entry.next := termList;
termList := SYSTEM.ADR(entry);
END Register;
PROCEDURE Init;
TYPE LibraryPtr = POINTER TO Library;
VAR lib : LibraryPtr;
BEGIN
SYSTEM.GET(4,execBase);
lib:=SYSTEM.VAL(LibraryPtr,execBase);
execVersion:=lib.version;
IF execVersion<37 THEN HALT(99) END
END Init;
PROCEDURE Term;
BEGIN
END Term;
BEGIN
termList := null;
Init;
Register(termEntry, Term);
END AmigaExec.
(.txt)